Mac Format 1995 June/MacFormat 25.iso/Shareware City/Developers/ICProgKit1.0/Source/ICReadOnly/ICReadOnly.p

Text File | 1994-11-27 | 9KB | 323 lines

unit ICReadOnly;

interface

    uses
        Components;

    function Main (var params: ComponentParameters; storage: Handle): ComponentResult;

implementation

    uses
{$ifc undefined THINK_Pascal}
        Types, Files, QuickDraw, Aliases, Packages, Memory, Errors, ToolUtils, Resources,

        ICTypes,
{$endc}
        Folders, ICCAPI, ICKeys;

    const
        kOurComponentManufacturer = 'ICRo';

    function DecStr (l: longint): Str32;
        var
            tmpstr: Str255;
    begin
        NumToString(l, tmpstr);
        DecStr := tmpstr;
    end; (* DecStr *)

    const
        kICCStart = 0;
        kICCStop = 1;
        kICCFindConfigFile = 2;
        kICCSpecifyConfigFile = 3;
        kICCGetSeed = 4;
        kICCBegin = 5;
        kICCGetPref = 6;
        kICCSetPref = 7;
        kICCCountPref = 8;
        kICCGetIndPref = 9;
        kICCEnd = 10;
        kICCDefaultFile = 11;
        kICCDeletePref = 12;
        kICCGetPerm = 13;

        kICC_first_select = kICCStart;
        kICC_last_select = kICCGetPerm;

    type
        globalsRecord = record
                self: ComponentInstance;
                target: ComponentInstance;
                delegate: ComponentInstance;
            end;
        globalsPtr = ^globalsRecord;
        globalsHandle = ^globalsPtr;

        sharedGlobals = record
                delegate: Component;
            end;
        sharedGlobalsPtr = ^sharedGlobals;

    function GetSharedGlobals (globals: globalsHandle): sharedGlobalsPtr;
        var
            shared: sharedGlobalsPtr;
    begin
        shared := nil;
        if GetComponentInstanceA5(globals^^.self) = 0 then begin
            shared := sharedGlobalsPtr(GetComponentRefcon(Component(globals^^.self)));
        end
        else begin
(* Debugger; *)
(* This, needless to say, is not the correct answer.  You're support to go madly search for the component. *)
(* I just can't be bothered to deal with this at the moment. *)
        end; (* if *)
        GetSharedGlobals := shared;
    end; (* GetSharedGlobals *)

(* Component Manager routines *)

    function RSCRegister (globals: globalsHandle): ComponentResult;
        var
            shared: sharedGlobalsPtr;
            err: OSErr;
            junk: OSErr;
    begin
        junk := SetDefaultComponent(Component(globals^^.self), defaultComponentIdentical + defaultComponentAnyFlags);
        shared := sharedGlobalsPtr(NewPtrSysClear(sizeof(sharedGlobals)));
        err := MemError;
        if err = noErr then begin
            shared^.delegate := nil;
            SetComponentRefcon(Component(globals^^.self), longint(shared));
        end; (* if *)
        RSCRegister := err;
    end; (* RSCRegister *)

    function RSCUnregister (globals: globalsHandle): ComponentResult;
        var
            shared: sharedGlobalsPtr;
            result: ComponentResult;
    begin
        result := -1;
        shared := GetSharedGlobals(globals);
        if shared <> nil then begin
            result := UncaptureComponent(shared^.delegate);
            DisposePtr(Ptr(shared));
        end; (* if *)
        RSCUnregister := result;
    end; (* RSCUnregister *)

    function RSCCanDo (globals: globalsHandle; selector: integer): ComponentResult;
    (* Handle the Component Manager CanDo request.*)
    begin
        case selector of
            kComponentUnregisterSelect..kComponentOpenSelect:
                RSCCanDo := 1;
            otherwise
                RSCCanDo := ComponentFunctionImplemented(globals^^.delegate, selector);
        end; (* case *)
    end; (* RSCCanDo *)

    function FindDelegate (after: Component): Component;
        var
            cd: ComponentDescription;
            found_cd: ComponentDescription;
            current: Component;
            found: boolean;
    begin
        cd.componentType := internetConfigurationComponentType;
        cd.componentSubType := internetConfigurationComponentSubType;
        cd.componentManufacturer := OSType(0);
        cd.componentFlags := 0;
        cd.componentFlagsMask := 0;
        current := after;
        repeat
            (* DebugStr(concat('in loop for ', kOurComponentManufacturer)); *)
            current := FindNextComponent(current, cd);
            if current <> nil then begin
                if GetComponentInfo(current, found_cd, nil, nil, nil) = noErr then begin
                    found := (found_cd.componentManufacturer <> kOurComponentManufacturer);
                end; (* if *)
            end; (* if *)
        until found or (current = nil);
        FindDelegate := current;
    end; (* FindDelegate *)

    function InitGlobals (globals: globalsHandle): ComponentResult;
        var
            err: ComponentResult;
            refnum: integer;
            strh: StringHandle;
            junk: OSErr;
    begin
        err := noErr;
        InitGlobals := err;
    end; (* InitGlobals *)

    function RSCOpen (globals: globalsHandle; self: ComponentInstance): ComponentResult;
    (* Handle the Component Manager Open request, mostly delayed until ICCStart. *)
        var
            err: ComponentResult;
            cap: Component;
            shared: sharedGlobalsPtr;
            tmp: Component;
    begin
        (* create our globals *)
        globals := globalsHandle(NewHandleClear(sizeof(globalsRecord)));
        err := MemError;
        if err = noErr then begin
            HLock(Handle(globals));
(* Debugger; *)
            globals^^.self := self;
            SetComponentInstanceStorage(self, Handle(globals));
            shared := GetSharedGlobals(globals);
            if shared <> nil then begin
                if shared^.delegate = nil then begin
                    tmp := FindDelegate(Component(self));
                    if tmp <> nil then begin
                        shared^.delegate := CaptureComponent(tmp, Component(self));
                    end; (* if *)
                end; (* if *)
                globals^^.delegate := OpenComponent(shared^.delegate);
                err := ComponentSetTarget(self, self);
            end; (* if *)
            if err = noErr then begin
                err := InitGlobals(globals);
            end; (* if *)
            HUnlock(Handle(globals));
        end; (* if *)
        RSCOpen := err;
    end; (* RSCOpen *)

    function RSCClose (globals: globalsHandle; self: ComponentInstance): ComponentResult;
    (* Handle the Component Manager Close request. *)
        var
            err: ComponentResult;
            junk: OSErr;
    begin
        err := noErr;
        if globals <> nil then begin
            if globals^^.delegate <> nil then begin
                junk := CloseComponent(globals^^.delegate)
            end; (* if *)
            DisposeHandle(Handle(globals));
        end; (* if *)
        RSCClose := err;
    end; (* RSCClose *)

    function RSCTarget (globals: globalsHandle; new_target: ComponentInstance): ComponentResult;
    (* Handle the Component Manager Target. *)
        var
            err: ComponentResult;
    begin
        globals^^.target := new_target;
        if globals^^.delegate <> nil then begin
            err := ComponentSetTarget(globals^^.delegate, new_target);
        end
        else begin
            err := noErr;
        end; (* if *)
        RSCTarget := err;
    end; (* RSCTarget *)

(* Internet Configuration specific routines *)

    const
        delegateThisCallErr = 1;

    function RSCGetPref (globals: globalsHandle; key: Str255; var attr: ICAttr; buf: Ptr; var size: longint): ICError;
        var
            err: ICError;
    begin
        err := ICCGetPref(globals^^.delegate, key, attr, buf, size);
        bset(attr, ICattr_locked_bit);
        RSCGetPref := err;
    end; (* RSCGetPref *)

    function RSCSetPref (globals: globalsHandle; key: Str255; var attr: ICAttr; buf: Ptr; var size: longint): ICError;
    begin
        RSCSetPref := icPermErr;
    end; (* RSCSetPref *)

    function WhatToStr (what: integer): Str32;
    begin
        case what of
            (* Component Manager stuff *)
            kComponentVersionSelect:
                WhatToStr := 'kComponentVersionSelect';
            kComponentCanDoSelect:
                WhatToStr := 'kComponentCanDoSelect';
            kComponentOpenSelect:
                WhatToStr := 'kComponentOpenSelect';
            kComponentCloseSelect:
                WhatToStr := 'kComponentCloseSelect';
            kComponentTargetSelect:
                WhatToStr := 'kComponentTargetSelect';
            kComponentRegisterSelect:
                WhatToStr := 'kComponentRegisterSelect';
            kComponentUnregisterSelect:
                WhatToStr := 'kComponentUnregisterSelect';
            (* this component type stuff *)
            kICCGetPref:
                WhatToStr := 'kICCGetPref';
            kICCSetPref:
                WhatToStr := 'kICCSetPref';
            otherwise
                WhatToStr := 'other';
        end; (* case *)
    end; (* WhatToStr *)

    function Main (var params: ComponentParameters; storage: Handle): ComponentResult;
    (* Component entry point.  It's pretty neat IMHO. *)
        var
            proc: ProcPtr;
            s: signedByte;
            res: longint;
    begin
        proc := nil;
(* DebugStr(concat('Enter ', WhatToStr(params.what))); *)
        case params.what of
            (* Component Manager stuff *)
            kComponentVersionSelect:
                Main := internetConfigurationComponentInterfaceVersion;
            kComponentCanDoSelect:
                proc := @RSCCanDo;
            kComponentOpenSelect:
                proc := @RSCOpen;
            kComponentCloseSelect:
                proc := @RSCClose;
            kComponentTargetSelect:
                proc := @RSCTarget;
            kComponentRegisterSelect:
                proc := @RSCRegister;
            kComponentUnregisterSelect:
                proc := @RSCUnregister;
            (* this component type stuff *)
            kICCGetPref:
                proc := @RSCGetPref;
            kICCSetPref:
                proc := @RSCSetPref;
            otherwise
                ;
        end; (* case *)
        if storage <> nil then begin
            s := HGetState(storage);
            HLock(storage);
        end; (* if *)
        res := delegateThisCallErr;
        if proc <> nil then begin
            res := CallComponentFunctionWithStorage(storage, params, proc);
        end; (* if *)
        if res = delegateThisCallErr then begin
            res := DelegateComponentCall(params, globalsHandle(storage)^^.delegate);
        end; (* if *)
(* DebugStr(concat('Exit ', WhatToStr(params.what), ' with res ', DecStr(res))); *)
        Main := res;
        if storage <> nil then begin
            HSetState(storage, s);
        end; (* if *)
    end; (* Main *)

end. (* ICReadOnly *)